Delphi Informant Complete 1995 - 2000/Delphi Informant Complete 1995 to 2000.iso/Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar/1998/Jul/DI9807NU/StatLnB.pas

Pascal/Delphi Source File | 1998-03-19 | 6KB | 183 lines

{ Listing One }
unit StatLnB; { Customized, stand-alone version of Statln feature }

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  RzStatus, ExtCtrls, RzPanel, Featcomp, StdCtrls;

type
{ These classes are used by Propel to store the property data for each
  array connection }
  TStatusLineSpecialPropObj = class(TFeatureArrayPropObj)
  private
    FGlyphMessage: String;
    FGlyphToShow: TBitmap;
    procedure SetGlyphToShow(Value: TBitmap);
  public
    constructor CreatePropObj(Feature: TCustomFeature;
                              ConnectionName: string;
                              IndexInArray: integer); override;
    destructor Destroy; override;
  published
  { These property names and types must match the names and types in the
    normal (Propel-native) feature }
    property GlyphMessage: String read FGlyphMessage write FGlyphMessage;
    property GlyphToShow: TBitmap read FGlyphToShow write SetGlyphToShow;
  end;

  TStatusLineSpecialPropObj1 = class(TFeatureArrayPropObj)
  private
    FStatusMessage: String;
  public
    constructor CreatePropObj(Feature: TCustomFeature;
                              ConnectionName: string;
                              IndexInArray: integer); override;
    destructor Destroy; override;
  published
  { This property name and type must match the name and type in the
    normal (Propel-native) feature }
    property StatusMessage: String read FStatusMessage write FStatusMessage;
  end;

{ Define Custom Feature Class }
  TStatusLineSpecial = class(TCustomFeature)
  protected
   { This procedure is where we connect the published properties Button1Props
     and Button2Props to the TFeatureArrayPropObj class for storage }
    procedure DefineArrayProperties(Proc: TDefineArrayPropertiesProc); override;
  public
    constructor Create(AOwner: TComponent);  override;
  published
  { These properties allow users to edit the array properties in
    the object inspector }
    property Button1Props: TFeatureArrayProperty read GetFeatArrayProp
             write SetFeatArrayProp stored false;
    property Button2Props: TFeatureArrayProperty read GetFeatArrayProp
             write SetFeatArrayProp stored false;
  end;

{ Define Feature Itself }
  TStatusLineFeature = class(TForm)
    RzStatusBar1: TRzStatusBar;
    RzStatusPane1: TRzStatusPane;
    RzResourceStatus1: TRzResourceStatus;
    RzClockStatus1: TRzClockStatus;
    RzGlyphStatus1: TRzGlyphStatus;
    ArrayConnector1: TArrayConnector;
    Button1: TButton;
    ArrayConnector2: TArrayConnector;
    Button2: TButton;
    FeatureDef1: TFeatureDef;
    procedure Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Button2Click(Sender: TObject);
  private { Propel-managed fields }
    FGlyphMessage: String;
    FGlyphToShow: TBitmap;
  published { Propel-managed properties }
    property GlyphMessage: String read FGlyphMessage write FGlyphMessage;
            {array  Button2}
    property GlyphToShow: TBitmap read FGlyphToShow write FGlyphToShow;
            {array  Button2}
  end;

  procedure Register;

var
  StatusLineFeature: TStatusLineFeature;

implementation

{$R *.DFM}

constructor TStatusLineSpecialPropObj.CreatePropObj(Feature: TCustomFeature;
                                                    ConnectionName: string;
                                                    IndexInArray: integer);

begin
  inherited CreatePropObj(Feature,ConnectionName,IndexInArray);
  FGlyphToShow := TBitmap.Create;
end;

destructor TStatusLineSpecialPropObj.Destroy;

begin
  FGlyphToShow.Free;
  inherited Destroy;
end;

procedure TStatusLineSpecialPropObj.SetGlyphToShow(Value: TBitmap);

begin
  FGlyphToShow.Assign(Value);
end;

constructor TStatusLineSpecial.Create(AOwner : TComponent);

begin
  inherited Create (AOwner);
  FeatureClass := 'TStatusLineFeature';
end;

constructor TStatusLineSpecialPropObj1.CreatePropObj(Feature: TCustomFeature;
                                                    ConnectionName: string;
                                                    IndexInArray: integer);

begin
  inherited CreatePropObj(Feature,ConnectionName,IndexInArray);
end;

destructor TStatusLineSpecialPropObj1.Destroy;

begin
  inherited Destroy;
end;

procedure TStatusLineSpecial.DefineArrayProperties(Proc:
                              TDefineArrayPropertiesProc);

begin
  Proc('Button1Props','Button1',TStatusLineSpecialPropObj1);
  Proc('Button2Props','Button2',TStatusLineSpecialPropObj);
end;

procedure TStatusLineFeature.Button1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
   PropObj: TStatusLineSpecialPropObj1;
begin
  If not Assigned(RzStatusPane1) then
    Exit;
  PropObj := TStatusLineSpecialPropObj1(FeatureDef1.GetArrayPropObject
             ('Button1Props', 'Button1', ArrayConnector1.IndexOf(Sender)));
  If PropObj = nil then
    Exit;
  RzStatusPane1.Caption := PropObj.StatusMessage;
end;

procedure TStatusLineFeature.Button2Click(Sender: TObject);
var
   PropObj: TStatusLineSpecialPropObj;
begin
  If not Assigned(RzGlyphStatus1) then
    Exit;
  PropObj := TStatusLineSpecialPropObj(FeatureDef1.GetArrayPropObject
             ('Button2Props', 'Button2', ArrayConnector2.IndexOf(Sender)));
  If PropObj = nil then
    Exit;
  If PropObj.GlyphToShow <> nil then
    RzGlyphStatus1.Glyph := PropObj.GlyphToShow;
  RzGlyphStatus1.Caption := PropObj.GlyphMessage;
end;

procedure Register;
begin
  RegisterComponents('Features',[TStatusLineSpecial]);
end;

initialization
  RegisterFeature(TStatusLineFeature);
end.